STraTOS 1997 April & May/STraTOS 1 - 1997 April & May.iso/CD01/UTILS/@FALCON/DESKAPPL/DESKAPPL.GFA

GFA-BASIC Atari | 1997-01-04 | 15.2 KB | 457 lines

' DESKAPPL.GFA
' Desktop Applications Luncher  ╜ '96-'97 by DuschnouK
' V. 1.02 - 04/01/97
' Système de lancement automatique de programmes à partir du bureau.
' Le principe est d'installer ce programme comme lien à tous les types de
' fichier, puis celui-ci se charge d'appeller les programmes voulus...
' Cela permet ainsi d'économiser de nombreux octets dans la mémoire du
' Newdesk, limité à 4Ko.
'
' Maintenant, en mettant le signe "%" devant un programme, on ne met que le
' nom du fichier, sans son chemin.
'
' On récupère les paramètres :
CLEAR
~SHEL_READ(cmd$,tail$)
tail$=UPPER$(tail$)
cmd$=UPPER$(cmd$)
'
' On récupère le chemin actuel :
d$=LEFT$(cmd$,RINSTR(cmd$,"\"))
'
IF tail$=""     ! Si le programme a été lancé, c'est qu'on veut l'installer
  @installe
  END
ENDIF
' Initialisation des paramètres :
@init
'
' On détermine quelle est l'extention du fichier
chercher&=LEN(tail$)-RINSTR(tail$,".")
IF chercher&<LEN(tail$)-RINSTR(tail$,"\")     ! Si il y bien un .xxx
  ext$=RIGHT$(tail$,chercher&)                ! On récupère l'extension
ELSE
  ext$="Y'a rien !"           ! Sinon, on met une extension impossible...
ENDIF
ext$=UPPER$(ext$)
'
'
' On détermine à quel programme est rattaché le fichier suivant son extention
find!=FALSE
FOR i&=1 TO 500
  EXIT IF prg$(i&,0)=""
  FOR j&=1 TO 30
    IF ext$=prg$(i&,j&)
      find!=TRUE
    ENDIF
    EXIT IF find!
    EXIT IF prg$(i&,j&)=""
  NEXT j&
  EXIT IF find!
NEXT i&
'
IF NOT find!
  ' Si aucune des extentions n'est trouvée dans la liste, 2 alternatives :
  ' 1 : C'est un programme (extention ttp,tos,prg,app,gtp) et on le lance
  ' 2 : C'est pas un prg, alors on lance le viewer par défaut (prg$(0,0))
  '  Écoute bien ce NB1, c'est important !
  ' NB1 : Pour le lancement de programme, une subtilité est à savoir, qui m'
  ' a pris 1 heure de tests... C'est que quand on récupère le Tail (tail$), il
  ' y a un caractère parasite qui est généré au tout début... Apparament, il
  ' FAUT LE GARDER pour les programmes qui ont un fichier lié, sinon le prg
  ' lancé ne retrouvera pas le fichier (!) ; mais il faut le VIRER quand on
  ' appelle un programme, sinon il ne le trouve pas !!!
  ' NB2 : En principe aucun programme ne se retrouvera intercepté par DeskAppl,
  ' à moins que vous ne l'installiez avec une extentions de programme, qui
  ' permet de contrôler le passage des paramètres, mais bloque le drag'n'drop.
  ' NB3 : QUI A DIT : "Poukoi k'il a pas fait là un Select/Case ?" ?!?
  ' La réponse est simple : LE COMPILATEUR DU GFA PLANTE !!
  ' => Cet imbécile de GFA avec le Select/Case regardais les 2 derniers
  ' caractères seulement... Résultat : si on avait un fichier .PP il croyais
  ' que c'était un .APP et le lançais kom prg !!
  ' Évidemment ce bug ne se manifeste qu'une fois le prg compilé...
  '
  IF ext$="TTP" OR ext$="TOS"
    grf&=0
    gem&=0
    '  On enlève le 1er caractère du tail$, cf NB1
    ~SHEL_WRITE(1,grf&,gem&,"",RIGHT$(tail$,LEN(tail$)-1))
  ELSE IF ext$="PRG" OR ext$="APP" OR ext$="GTP"
    grf&=1
    gem&=1
    '  On enlève le 1er caractère du tail$, cf NB1
    ~SHEL_WRITE(1,grf&,gem&,"",RIGHT$(tail$,LEN(tail$)-1))
  ELSE
    i&=0
    find!=TRUE
  ENDIF
ENDIF
'
' On détermine quel est le type du programme...
IF find!
  chercher&=LEN(prg$(i&,0))-RINSTR(prg$(i&,0),".")
  IF chercher&<LEN(prg$(i&,0))-RINSTR(prg$(i&,0),"\")    ! Si il y bien un .xxx
    ext$=RIGHT$(prg$(i&,0),chercher&)
  ELSE                                          ! Sinon rien
    ext$=""
  ENDIF
  ext$=UPPER$(ext$)
  '  Idem, pas de Select/Case car le compilateur plante.
  IF ext$="TTP" OR ext$="TOS"
    grf&=0
    gem&=0
    @conf_desk
  ELSE IF ext$="PRG" OR ext$="APP" OR ext$="GTP"
    grf&=1
    gem&=1
    @conf_desk
  ELSE
    CLS
    IF ext$=""
      PRINT "Vous avez omis de préciser quel était le programme de défaut."
      PRINT "Veuillez l'indiquer en éditant DESKAPPL.IDX avec un éditeur de texte,"
      PRINT "en modifiant la 1ère ligne."
      PRINT "Exemple : E:\7UP\7UP.APP,@"
    ELSE
      PRINT "Votre programme :"'prg$(i&,0)
      PRINT "A une mauvaise extension."
    ENDIF
    @click
  ENDIF
ENDIF
END
'
'
> PROCEDURE init
  DIM prg$(500,30)
  OPEN "I",#1,d$+"DESKAPPL.IDX"
  FOR i&=0 TO 500
    FOR j&=0 TO 30
      INPUT #1,ga$
      IF ga$<>"@"       ! SI CE N'EST PAS LA FIN DE LA LISTE(@) ON LIT
        prg$(i&,j&)=UPPER$(ga$)
      ENDIF
      EXIT IF ga$="@"   ! ON SE CASSE SI ON A (@)
    NEXT j&
    ' SI LE PREMIER CARACTèRE ÉTAIT "@" C'EST QUE C'EST LA FIN DE LA LISTE
    EXIT IF j&=0
  NEXT i&
  CLOSE #1
RETURN
> PROCEDURE installe
  CLS
  PRINT "                         Desktop Applications Luncher"
  PRINT "                             ╜ 1997 by DuschnouK"
  PRINT "                                  \V. 1.02/"
  PRINT "                        - Ce logiciel est un Freeware -"
  PRINT
  PRINT "Installation du programme."
  PRINT "Avant tout, procédez à une sauvegarde de vos Newdesk.inf, car ils vont"
  PRINT "être directement modifiés."
  PRINT
  ALERT 0,"|Bien compris ?  |",1,"Ok",cl&
  FILESELECT #"Où est DESKAPPL.PRG ?",d$+"DESKAPPL.PRG","DESKAPPL.PRG",deskappl$
  cl2&=1
  DO
    ALERT 2,"Quelle opération voulez-vous :|- Installer DeskAppL|- Enlever DeskAppL|- Nettoyer le Newdesk.inf",cl2&,"Installe|Enlève|Nettoie",cl2&
    FILESELECT #"Choisir un fichier Newdesk.inf",d$+"*.in?","",ga$
    d$=LEFT$(ga$,RINSTR(ga$,"\"))
    IF EXIST(ga$) AND EXIST(deskappl$)
      CLS
      DIM lignes$(5000)
      DIM index$(500,1)
      OPEN "I",#1,ga$
      RECALL #1,lignes$(),-1,nblignes#
      CLOSE #1
      DEC nblignes#    ! Car On commence à 0
      l&=0
      FOR i&=0 TO nblignes#
        l&=l&+LEN(lignes$(i&))
      NEXT i&
      '
      @nettoyage                  ! Dans tous les cas, on enlève la poussière ;-)
      SELECT cl2&
      CASE 1                              ! On installe DeskAppL :-)
        '  Installation de DESKAPPL.PRG.
        ' On doit l'installer juste après les lignes #W
        '
        wtest!=FALSE
        FOR i&=4 TO nblignes#
          IF LEFT$(lignes$(i&),2)="#W"  ! Si c'est une ligne #W
            wtest!=TRUE                 ! Alors on signale qu'on est passé dessus...
          ENDIF
          '  Et on se casse dès qu'on a quitté les lignes #W
          EXIT IF wtest! AND LEFT$(lignes$(i&),2)<>"#W"
        NEXT i&
        '
        '  Si on ne commence pas par #G ou "#N FF 04 000 @ *.*@ @" ! V. 1.01 !
        IF LEFT$(lignes$(i&),2)<>"#G" AND LEFT$(lignes$(i&),21)<>"#N FF 04 000 @ *.*@ @"
          INSERT lignes$(i&)="#G 03 04 200 "+deskappl$+"@ *.*@ "      ! On insert une ligne
          INC nblignes#                                          ! Incrémentation
        ELSE
          '  Sinon ça signifie que c'était déjà installé, et on modifie simplement :
          lignes$(i&)="#G 03 04 200 "+deskappl$+"@ *.*@ "
        ENDIF
        ' ! V. 1.01 !
        FOR j&=i& TO nblignes#
          IF LEFT$(lignes$(j&),21)="#N FF 04 000 @ *.*@ @"
            DELETE lignes$(j&)
            DEC j&
            DEC nblignes#
          ENDIF
        NEXT j&
        '
        '  Dans les lignes suivantes, on va récupérer les programmes déjà installés
        j&=1    ! L'indice 0 est pour le prg par défaut
        FOR i&=i&+1 TO nblignes#
          '  Ça correspond aux lignes qui indiquent au TOS quels sont les fichiers
          ' correspondants à des programmes
          ckoa$=LEFT$(lignes$(i&),2)
          IF ckoa$="#G" OR ckoa$="#Y" OR ckoa$="#P" OR ckoa$="#F"
            IF LEN(lignes$(i&))>24     ! Si ce n'est pas une information système
              IF MID$(lignes$(i&),11,2)="00"
                ' Si un programme est installé, mais qu'il n'est pas affecté à une
                ' touche de fonction, on récupère son chemin et paramètre et on le vire
                IF INSTR(lignes$(i&),"@ @")<>0
                  index$(j&,0)=MID$(lignes$(i&),14,INSTR(lignes$(i&),"@")-14)
                  index$(j&,1)=MID$(lignes$(i&),INSTR(lignes$(i&),"*.")+2,INSTR(lignes$(i&),"@ @")-INSTR(lignes$(i&),"*.")-2)
                  IF index$(j&,1)<>"*"    ! Si ce programme ne prend pas tous les fichiers
                    DELETE lignes$(i&)    ! On le vire de la liste
                    DEC nblignes#          ! Et on n'oublie pas de remettre ses pointeurs
                    DEC i&                ! Une case avant...
                    INC j&
                  ELSE                    ! Sinon c'est que y'a un pb !
                    DELETE lignes$(i&)    ! Et on le vire !
                    DEC nblignes#
                  ENDIF
                ELSE                    ! Sinon y'a aussi un pb...
                  DELETE lignes$(i&)    ! Et on le vire !
                  DEC nblignes#
                ENDIF
              ENDIF
            ENDIF
          ENDIF
        NEXT i&
        DEC j&          ! Il y a tjs un j& de trop
        '
        ' Maintenant on va à nouveau installer DeskAppL, mais avec une extention
        ' folklorique, de manière à ne pas bloquer l'installation de nouveaux
        ' programmes... ╢ noter qu'on peut aussi mettre comme extention finale
        ' *.TTP ou *.GTP pour que le programme gère la ligne de commande... Mais
        ' dans ce cas, le drag'n'drop ne marchera plus !
        '
        ' Donc d'abord on vire les éventuelles installation déjà faites...
        FOR i&=nblignes#-4 TO nblignes#
          IF LEFT$(lignes$(i&),12)="#G 03 04 200"
            DELETE lignes$(i&)
            DEC i&
            DEC nblignes#
          ENDIF
        NEXT i&
        '
        '  Ici, vous pouvez décider que DeskAppL va intercepter certains types
        ' de programmes (ttp,gtp...) pour gérer la ligne de commande...
        ' Mais le Drag'n'drop risque de ne plus fonctionner.
        '       lignes$(nblignes+1)="#G 03 04 200 "+deskappl$+"@ *.TTP@ "
        '       INC nblignes
        '
        d2$=LEFT$(deskappl$,RINSTR(deskappl$,"\"))
        dskidx!=EXIST(d2$+"DESKAPPL.IDX")
        IF dskidx!
          ALERT 1,"|Remplacer, ajouter|les paramètres ou ne|rien faire ?",3,"Remplace|Ajoute|Rien",cl&
        ENDIF
        '
        CLS
        FOR i&=0 TO nblignes#
          l&=l&-LEN(lignes$(i&))
        NEXT i&
        PRINT "Votre Newdesk.inf a perdu"'l&'"octets."
        ' Le programme installé en *.doc ou *.txt est installé en suplément en
        ' viewer par défaut.
        FOR i&=0 TO j&
          IF index$(i&,1)="DOC" OR index$(i&,1)="TXT"
            index$(0,0)=index$(i&,0)
            def!=TRUE
          ENDIF
        NEXT i&
        '
        '
        ' Maintenant on sauve tout
        '
        PRINT "Sauvegarde en cours..."
        PRINT ga$
        OPEN "O",#1,ga$
        STORE #1,lignes$(),nblignes#+1      ! STORE génère un CR/LF indispensable...
        CLOSE #1
        PRINT "Les éventuelles lignes foireuses on étés suprimées..."
        PRINT "=> En principe, tous les problèmes de racourcis claviers qui sautent,"
        PRINT "et autres programmes auto-boot qui ne se chargent pas sont résolus :-)"
        IF cl&=1 OR NOT dskidx!
          PRINT d2$+"DESKAPPL.IDX"
          OPEN "O",#1,d2$+"DESKAPPL.IDX"    ! Open, on remplace tout
          PRINT #1,index$(0,0)+",@"   ! C'est le programme par défaut
          IF def!
            PRINT "Le viewer par défaut est"'index$(0,0)
          ELSE
            PRINT "Attention : il faudra préciser sur la 1ère ligne quel est"
            PRINT "le programme qui sera utilisé en défaut."
            PRINT "Pour ce faire, éditez DESKAPPL.IDX avec un éditeur de texte (genre 7UP)."
          ENDIF
        ELSE IF cl&=2
          PRINT d2$+"DESKAPPL.IDX"
          OPEN "A",#1,d2$+"DESKAPPL.IDX"    ! Append, on va rajouter les infos
        ENDIF
        IF cl&<>3             ! Si on a pas annulé la modif...
          FOR i&=1 TO j&
            PRINT #1,index$(i&,0)+","+index$(i&,1)+",@"
          NEXT i&
          PRINT #1,"@"      ! C'est fini !!
          CLOSE #1
          PRINT "Les doublons ne sont pas vérifiés..."
        ENDIF
        IF cl&=2
          PRINT "On purge le @ en trop..."
          OPEN "I",#1,d2$+"DESKAPPL.IDX"
          RECALL #1,lignes$(),-1,nblignes#   ! On fait de la réutilisation...
          CLOSE #1
          ' On cherche le @ seul du précédent réglage, et on le vire...
          FOR i&=0 TO nblignes#-1
            EXIT IF lignes$(i&)="@" ! On se casse dès qu'on a trouvé le gros lot !
          NEXT i&
          IF i&<nblignes#-1          ! On sait jamais...
            DELETE lignes$(i&)
          ENDIF
          OPEN "O",#1,d2$+"DESKAPPL.IDX"
          STORE #1,lignes$(),nblignes#
          CLOSE #1
        ENDIF
        IF j&=0 AND cl&=1
          PRINT "DESKAPPL.IDX ne contient aucun programme lié car votre Newdesk.inf n'en"
          PRINT "contenait (en principe) pas... Donc à vous de l'éditer !"
        ELSE IF j&=0 AND cl&=2
          PRINT "Aucune application n'a étée rajoutée car votre Newdesk.inf n'en contenait pas"
        ENDIF
        PRINT "P.S. : Les programmes liés mais qui sont appellables par une touche de"
        PRINT "fonction sont laissés dans le Newdesk.inf."
        PRINT "Installation terminée !"
        PRINT "Chargez"'ga$'"et ça roule !!"
      CASE 2,3                  ! Désintallation ou Nettoyage
        IF cl2&=2
          '  On cherche où a été installé DeskAppL
          FOR i&=0 TO nblignes#
            EXIT IF LEFT$(lignes$(i&),13+LEN(deskappl$))="#G 03 04 200 "+deskappl$
          NEXT i&
          '  Et si on l'a bien trouvé...
          IF i&<nblignes#+1
            '  On réinstalle la gestion de tous les fichiers (*.*) par le GEM
            ' /!\ Ceci est très important, car sinon le GEM va refuser tout
            '     accès à des fichiers autres que les programmes !
            lignes$(i&)="#N FF 04 000 @ *.*@ @ "
            PRINT deskappl$'"a été enlevé de"'ga$;"."
            PRINT "Les programmes liés n'ont pas été réinstallés... Car il vaut mieux le faire à"
            PRINT "la ""main"" pour installer les programmes dont vous avez vraiment besoin."
          ELSE
            PRINT deskappl$'"n'a pas été trouvé..."
            PRINT "La désinstallation n'a pas étée effectuée."
            PRINT "Un truc : installez DeskAppL puis désinstallez-le !"
          ENDIF
        ELSE
          PRINT "Nettoyage..."
        ENDIF
        PRINT "Sauvegarde en cours..."
        PRINT ga$
        OPEN "O",#1,ga$
        STORE #1,lignes$(),nblignes#+1      ! STORE génère un CR/LF indispensable...
        CLOSE #1
      ENDSELECT
      @click
      ERASE lignes$(),index$()    ! On supprime les buffers...
      ALERT 3,"|Voulez-vous définir un|autre Newdesk.inf ?",1,"Oui|Non",cl3&
    ENDIF
  LOOP UNTIL ga$="" OR cl3&=2
RETURN
> PROCEDURE nettoyage
  ' Cette procédure "nettoie" le Newdesk.inf des lignes & messages foireux.
  '
  ' La 3ème ligne DOIT faire 47 octets (y'a 45 espaces nécessaire)
  IF LEFT$(lignes$(3),2)="#d" AND LEN(lignes$(3))<47
    lignes$(3)="#d"+SPACE$(45)
  ENDIF
  ' Ensuite on regarde si y'a un "blob" dans la 4ème ligne : càd en
  ' général que on peut avoir une liste de définition des racourcis clavier
  ' qui sont foireux (et va entraîner un plantage de ces fonctions) ou qu'il
  ' y a un paramêtre d'auto-boot qui y est inclu, du style :
  ' #K 4F 49 52 58 4E #Z 01 @
  '  Une ligne de #K... doit comporter 97 octets, sinon on la vire
  '  Cette ligne #K peut se trouver en 4 ou 5ème position selon qu'il y ai
  ' ou non un programme auto-lancé
  FOR i&=4 TO 5
    IF LEFT$(lignes$(i&),2)="#K"  ! Si c'est une ligne de racourcis clavier
      IF LEN(lignes$(i&))<97      ! Et qu'elle est inférieure à 97 octets
        DELETE lignes$(i&)        ! Alors on la vire
        DEC nblignes#              ! Et on décrémente le nb de lignes !
        del!=TRUE                 ! On a viré une ligne !
      ENDIF
    ENDIF
    EXIT IF del!                  ! On se casse si on a viré une ligne #K
  NEXT i&
  '
  ' ! V 1.01 !
  ' On enlève la ligne "#N FF 04 000 @ *.*@ @" s'il y en a plusieurs
  '
  diese_n!=FALSE
  FOR i&=0 TO nblignes#
    IF LEFT$(lignes$(i&),21)="#N FF 04 000 @ *.*@ @" AND diese_n!
      PRINT i&
      DELETE lignes$(i&)
      DEC nblignes#
      DEC i&
    ELSE IF LEFT$(lignes$(i&),21)="#N FF 04 000 @ *.*@ @"
      diese_n!=TRUE
    ENDIF
  NEXT i&
RETURN
> PROCEDURE click
  PRINT "Cliquez ou appuyez sur une touche..."
  DO
  LOOP UNTIL MOUSEK=0 AND INP?(2)=0
  DO
  LOOP UNTIL MOUSEK OR INP?(2)
  DO
    IF INP?(2)
      ~INP(2)
    ENDIF
  LOOP UNTIL MOUSEK=0 AND INP?(2)=0
RETURN
> PROCEDURE conf_desk
  ' V. 1.02
  ' Permet de donner en paramêtre que le nom du fichier si on met le signe "%"
  ' au début de la ligne.
  ' Ex: vous avez défini le prg :
  ' E:\BHOU\HAHA\BOUM.PRG,KJU,JHT,@
  ' Et ça ne marche pas ? => Testez cela :
  ' %E:\BHOU\HAHA\BOUM.PRG,KJU,JHT,@
  ' Simple non ? Le mode % équivaut au fait de déplacer un fichier sur une icône
  ' de programme (drag & drop).
  ' Il faut savoir que le mode par défaut envoie en paramêtre le nom du fichier
  ' avec son chemin complet. Mais certains prgs peuvent foirer car ils ne
  ' veulent que le nom du fichier, car ils peuvent récupérer le chemin.
  ' Il faut savoir que ce chemin ne peut être QUE celui de la fenêtre active...
  ' Il y a certains prgs comiques qui veulent le chemin d'eux-même, alors qu'ils
  ' peuvent le récupérer dans la ligne de commande... Or après qqs tests, le GEM
  ' annule les modifs au chemin par défaut que l'on peut faire et remet celui
  ' qui avait cours... Donc on ne peut rien faire, sauf à aller voir où il
  ' stocke ça en mémoire, mais c'est pas très simple (amusez-vous à le faire ;-)
  ' Mais bon, ce genre de pb ne concerne guère que 5% des prgs...
  '
  '  S'il y a un signe "%"
  IF LEFT$(prg$(i&,0))="%"      ! Ben dans ce cas il n'aura ke le nom du fichier
    prg$(i&,0)=RIGHT$(prg$(i&,0),LEN(prg$(i&,0))-1)
    '  On veut que le nom du fichier
    ' Le "+1" est une subtilité indispensable, car un caractère étrange
    ' fou la m...
    tail$=RIGHT$(tail$,LEN(tail$)-RINSTR(tail$,"\")+1)
  ENDIF
  ~SHEL_WRITE(1,grf&,gem&,tail$,prg$(i&,0))
RETURN